home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / morris / blowup.bas < prev    next >
Encoding:
BASIC Source File  |  1994-11-15  |  10.7 KB  |  304 lines
  1. '==========================================================
  2. '
  3. '    Module - BLOWUP.BAS
  4. '
  5. '    Module Prefix - None
  6. '
  7. '    Author - Peter J. Morris. TMS Ltd.
  8. '
  9. '    Date Written : #### Date - 16/11/94    Time - 03:11
  10. '
  11. '    Purpose -
  12. '    Support module for  TMS  blowup  used  for  demonstration purposes only.
  13. '    The 'C' source for the DLL is normally to be distributed with this demo.
  14. '    TMS dudes/dudettes - this code may not be used without error handlers.
  15. '
  16. '    Revisions
  17. '    BY            WHY            AFFECTED
  18. '    Peter J. Morris. TMS Ltd. Original code.
  19. '
  20. '==========================================================
  21.  
  22.  
  23. Option Explicit
  24.  
  25.  
  26. ' General dummy variable - variant so that it can hold anything!
  27. Global g_vDummy As Variant
  28.  
  29. ' Use to hold a window's dimensions typically.
  30. Type RECT
  31.      Left    As Integer
  32.      Top     As Integer
  33.      Right   As Integer
  34.      Bottom  As Integer
  35. End Type
  36.  
  37. ' Holds information regarding a window's position on the desktop.
  38. Type WINDOWPOS
  39.      hWnd            As Integer
  40.      HwndInsertAfter As Integer
  41.      X               As Integer
  42.      Y               As Integer
  43.      CX              As Integer
  44.      CY              As Integer
  45.      Flags           As Integer
  46. End Type
  47.  
  48. ' Copy long pointer to WINDOWPOS structure functions/possibilities.
  49.  
  50. ' Custom DLL function to copy one WINDOWPOS to another! Both are passed as
  51. ' pointers - trouble is that the second is a 'Long' in VB so we need a DLL
  52. ' to do this.
  53. ' ----------------------------------------------------------------
  54. ' COMMENT IN #1 IN MsgBlaster1_Message TO SEE THIS WORK (DEFAULT).
  55. ' ----------------------------------------------------------------
  56. Declare Function CopyWP1 Lib "DLL.DLL" Alias "nGetWindowPos" (t As WINDOWPOS, ByVal l As Long) As Integer
  57.  
  58.  
  59. ' This  standard  'kernel' function  would  almost  do and save us from
  60. ' having to write our own DLL function. We would declare it as follows.
  61. ' The 'problem' with  this  function is that it doesn't always copy 'n'
  62. ' bytes.  It'll stop if it finds a NULL (a byte that contains the value
  63. ' 0) in the source string - bugger!
  64. ' -----------------------------------------------------------
  65. ' COMMENT IN #2 IN MsgBlaster1_Message TO SEE IT ALMOST WORK.
  66. ' -----------------------------------------------------------
  67. Declare Function CopyWP2 Lib "Kernel" Alias "lstrcpyn" (t As WINDOWPOS, ByVal l As Long, ByVal n As Integer) As Long
  68.  
  69.  
  70. ' However, this  standard  function does  exist and DOES save us from having
  71. ' to write our own function. hmemcpy is 'in'  Windows 3.1  and  later and is
  72. ' used to copy one area of memory to another. Note that ALL memory is copied,
  73. ' i.e. a NULL byte is nothing special to hmemcpy.
  74. ' ------------------------------------------------------
  75. ' COMMENT IN #3 IN MsgBlaster1_Message TO SEE THIS WORK.
  76. ' ------------------------------------------------------
  77. Declare Sub CopyWP3 Lib "Kernel" Alias "hmemcpy" (t As WINDOWPOS, ByVal l As Long, ByVal n As Long)
  78.  
  79.  
  80. ' Windows' API procedures used throughout.
  81. Declare Function MoveTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
  82. Declare Function LineTo Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
  83. Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  84. Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  85. Declare Function SetROP2 Lib "GDI" (ByVal hDC As Integer, ByVal nDrawMode As Integer) As Integer
  86. Declare Function WinHelp Lib "User" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal nCommand As Integer, ByVal dwData As Long) As Integer
  87. Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)
  88. Declare Sub DrawFocusRect Lib "User" (ByVal hDC As Integer, lpRect As RECT)
  89. Declare Sub InflateRect Lib "User" (lpRect As RECT, ByVal X As Integer, ByVal Y As Integer)
  90.  
  91.  
  92. ' Used to test 'Flags' member in WINDOWPOS struct passed into TMSExplodeForm as nFlags.
  93. Const SWP_NOACTIVATE = &H10
  94. Const SWP_NOMOVE = &H2
  95. Const SWP_NOSIZE = &H1
  96.  
  97. Const R2_NOT = 6
  98.  
  99. ' Used by the message blaster control.
  100. Global Const PREPROCESS = -1
  101. Global Const EATMESSAGE = 0
  102. Global Const POSTPROCESS = 1
  103. Global Const WM_WINDOWPOSCHANGING = &H46
  104.  
  105. ' NUM_DELAY is used as a 'base' upper limit for a general delay loop counter.
  106. Const NUM_DELAY = 5000
  107.  
  108. ' Number of seperate explosion states.
  109. Const NUM_STEPS = 10
  110.  
  111. '==========================================================
  112. '
  113. '    Function - TMSExplodeForm
  114. '
  115. '    Author - Peter J. Morris. TMS Ltd.
  116. '
  117. '    Date Written: #### Date - 16/11/94    Time - 03:11
  118. '
  119. '    Purpose - See function purpose.
  120. '
  121. '    Revisions:
  122. '    BY            WHY            AFFECTED
  123. '    Peter J. Morris. TMS Ltd. Original code.
  124. '
  125. '
  126. '    INPUTS -  frm     -> Form to explode.
  127. '              tNewPos -> A RECT which is the window's new screen position.
  128. '              nFlags  -> Flags member of the WINDOWPOS structure.
  129. '
  130. '    OUTPUTS - None, except a dazzling effect!
  131. '
  132. '==========================================================
  133. Sub TMSExplodeForm (frm As Form, tNewPos As RECT, ByVal nFlags As Integer)
  134. '==========================================================
  135. '
  136. '    Form: BLOWUP.BAS Procedure: TMSExplodeForm
  137. '
  138. '    Author - Peter J. Morris. TMS Ltd.
  139. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  140. '
  141. '    Copyright and status if any: Copyright ⌐ TMS 1994,1995
  142. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  143. '
  144. '    Purpose/Description In brief:
  145. '
  146. '    This is the routine that explodes the frm given in 'frm'.  This  routine is called from
  147. '    the  message blaster 'call-back' event handler.  It is passed a rectangle wihich is the
  148. '    exploding form's 'new' screen position, a flags variable explaining what is causing the
  149. '    explosion and of course the form to explode.
  150. '
  151. '=========================================================
  152.  
  153. ' Set up general error handler
  154.  
  155. 'On Error GoTo Error_TMSExplodeForm:
  156.  
  157.     ' ========== Code Starts.==========
  158.  
  159.     ' General loop counter.
  160.     Dim nLoop              As Integer
  161.     
  162.     ' Delay loop counter.
  163.     Dim lDelayCount        As Long
  164.     
  165.     ' The new width and height required.
  166.     Dim nWindowWidth       As Integer
  167.     Dim nWindowHeight      As Integer
  168.     
  169.     ' Window's current screen position.
  170.     Dim tOldPos            As RECT
  171.     
  172.     ' Hold 'device/display context' for entire desktop window.
  173.     Dim hDCScreen          As Integer
  174.    
  175.     ' Ignore stuff that shouldn't bother us - we don't want to explode all the time!
  176.     If ((nFlags And SWP_NOMOVE) = SWP_NOMOVE) Or ((nFlags And SWP_NOSIZE) = SWP_NOSIZE) Or (nFlags = 0) Then Exit Sub
  177.     
  178.     ' Get current window size etc.
  179.     GetWindowRect frm.hWnd, tOldPos
  180.     
  181.     ' Get new required height and width.
  182.     nWindowWidth = tNewPos.Right - tNewPos.Left
  183.     nWindowHeight = tNewPos.Bottom - tNewPos.Top
  184.  
  185.     ' Get a device context for the screen - this is so that
  186.     ' we can draw anywhere on the screen.
  187.     hDCScreen = GetDC(0)
  188.  
  189.     ' Set  our  drawing  mode so that the pen draw  with the inverse
  190.     ' color used in  the  current  pixel  location. This is  used to
  191.     ' ensure that  the  lines  drawn  from  the edge of the old rect
  192.     ' to the edges of the new rect do destroy any of the background.
  193.     g_vDummy = SetROP2(hDCScreen, R2_NOT)
  194.     
  195.     ' 'Grow' 'where it is' and 'where it will be' rectangles by a pel - makes
  196.     ' drawing the initial rectangle around them look a little nicer.
  197.     InflateRect tNewPos, 1, 1
  198.     InflateRect tOldPos, 1, 1
  199.  
  200.     For nLoop = 0 To 1
  201.  
  202.         ' Draw a line from  each  corner of the 'where it is' rectangle to the
  203.         ' each corner of the 'where it will be' rectangle.  Once the lines are
  204.         ' drawn, draw a box around each rectangle. After a short delay un-draw
  205.         ' each box/line.
  206.     
  207.         ' Top left.
  208.         g_vDummy = MoveTo(hDCScreen, tOldPos.Left, tOldPos.Top)
  209.         g_vDummy = LineTo(hDCScreen, tNewPos.Left, tNewPos.Top)
  210.         
  211.         ' Top right.
  212.         g_vDummy = MoveTo(hDCScreen, tOldPos.Right, tOldPos.Top)
  213.         g_vDummy = LineTo(hDCScreen, tNewPos.Right, tNewPos.Top)
  214.         
  215.         ' Bottom right.
  216.         g_vDummy = MoveTo(hDCScreen, tOldPos.Right, tOldPos.Bottom)
  217.         g_vDummy = LineTo(hDCScreen, tNewPos.Right, tNewPos.Bottom)
  218.         
  219.         ' Bottom left.
  220.         g_vDummy = MoveTo(hDCScreen, tOldPos.Left, tOldPos.Bottom)
  221.         g_vDummy = LineTo(hDCScreen, tNewPos.Left, tNewPos.Bottom)
  222.         
  223.         ' Draw outlines on 'where it is' and 'where it will be' rectangles.
  224.         DrawFocusRect hDCScreen, tNewPos
  225.         DrawFocusRect hDCScreen, tOldPos
  226.     
  227.         ' Do the next bit - the  delay - only if we've been through the loop
  228.         ' once before, i.e. not if  this is the 'un-draw everything'  run as
  229.         ' the delay is used to give us an adjustable 'pause' between drawing
  230.         ' and undrawing, not exiting this loop!
  231.         If nLoop = 1 Then Exit For
  232.  
  233.         ' Delay between undrawing. Change multiplier for greater delay. Note
  234.         ' that '&' is used to prevent integer overflow here.
  235.         For lDelayCount = 0 To NUM_DELAY * 6&
  236.         Next
  237.     
  238.     Next
  239.  
  240.     ' Now draw the exploding rectangles.
  241.  
  242.     Dim nStartX     As Integer
  243.     Dim nStartY     As Integer
  244.     Dim nXInc       As Integer
  245.     Dim nYInc       As Integer
  246.     Dim nInnerLoop  As Integer
  247.     
  248.     ' Start exploding from the center of the rectangle.
  249.     nStartX = nWindowWidth / 2
  250.     nStartY = nWindowHeight / 2
  251.      
  252.     ' Work out how many pels to an explode 'explode step'.
  253.     nXInc = (nWindowWidth / NUM_STEPS) / 2
  254.     nYInc = (nWindowHeight / NUM_STEPS) / 2
  255.  
  256.     ' Set begining position (center form).
  257.     tNewPos.Left = tNewPos.Left + nStartX
  258.     tNewPos.Top = tNewPos.Top + nStartY
  259.     tNewPos.Right = tNewPos.Left + 0
  260.     tNewPos.Bottom = tNewPos.Top + 0
  261.  
  262.     ' Do the 'inner' explosion.
  263.     For nLoop = 1 To NUM_STEPS
  264.  
  265.         ' Adjust rect.
  266.         InflateRect tNewPos, nXInc, nYInc
  267.  
  268.         ' Draw some focus rectangles.
  269.         DrawFocusRect hDCScreen, tNewPos
  270.         
  271.         ' Delay between undrawing. Change multiplier for greater delay. Note
  272.         ' that '&' is used to prevent integer overflow here.
  273.         For lDelayCount = 0 To NUM_DELAY * 2&
  274.         Next
  275.         
  276.         ' Un-draw the rectangle.
  277.         DrawFocusRect hDCScreen, tNewPos
  278.  
  279.     Next
  280.  
  281.     g_vDummy = ReleaseDC(0, hDCScreen)
  282.  
  283.  
  284.     ' ========== Code Ends  .==========
  285.  
  286.     Exit Sub
  287.  
  288. ' Error handler
  289. Error_TMSExplodeForm:
  290.  
  291.     ' Call general error handler
  292.  
  293.     ErrorHandler "BLOWUP.BAS/TMSExplodeForm", Err, Error$
  294.  
  295.     ' Default resume behaviour: exit this sub/func
  296.  
  297.     Resume Exit_TMSExplodeForm:
  298.  
  299. Exit_TMSExplodeForm:
  300.  
  301.  
  302. End Sub
  303.  
  304.